home *** CD-ROM | disk | FTP | other *** search
- # Program: xf
- # Description: handle text widgets
- #
- # $Header: TkGS[2.3] Wed Mar 10 11:57:33 1993 garfield@garfield frozen $
-
- global xfDefaultConf
- set xfDefaultConf(tkgs) 4
-
- ##########
- # Procedure: XFAdd.TkGS
- # Description: add a tkGS
- # Arguments: xfW - the widget
- # xfName - a optional name
- # xfType - add or config
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFAdd.TkGS {xfW xfName xfType} {
- global xfFile
- global xfStatus
-
- XFEditSetStatus "Inserting TkGS..."
- set xfName [XFMiscGetUniqueName $xfName gs]
- set xfTmpOptions ""
- if {"$xfFile(gsCmd)" != ""} {
- append xfTmpOptions " -command \{$xfFile(gsCmd)\}"
- }
- if {"$xfStatus(path)" == "."} {
- if {[catch "tkgs .$xfName $xfTmpOptions" xfResult]} {
- XFProcError "$xfResult"
- XFEditSetStatus "Inserting TkGS...aborted"
- return
- }
-
- XFMiscPositionWidget .$xfName
- XFMiscBindWidgetTree .$xfName
- } {
- if {[catch "tkgs $xfStatus(path).$xfName $xfTmpOptions" xfResult] != 0} {
- XFProcError "$xfResult"
- XFEditSetStatus "Inserting TkGS...aborted"
- return
- }
-
- XFMiscPositionWidget $xfStatus(path).$xfName
- XFMiscBindWidgetTree $xfStatus(path).$xfName
- }
-
- incr xfStatus(elementCounter)
- XFEditSetPath $xfStatus(path)
- XFEditSetStatus "Inserting TkGS...done"
- }
-
- ##########
- # Procedure: XFAddTmp.TkGS
- # Description: add a tmp tkGS
- # Arguments: none
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFAddTmp.TkGS {} {
- }
-
- ##########
- # Procedure: XFConfig.TkGS4
- # Description: configure a tkGS
- # Arguments: xfW - the widget
- # xfType - config type (add config)
- # xfClass - the class we configure
- # xfLeader - the leading window
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFConfig.TkGS4 {xfW xfType xfClass {xfLeader ""}} {
- global xfBind
- global xfMisc
- global xfStatus
-
- if {"$xfType" == "add"} {
- set xfName gs$xfStatus(elementCounter)
- } {
- set xfName [XFMiscPathName $xfW]
- }
- XFEditSetStatus "Calling parameter setting for TkGS..."
-
- # build widget structure
- XFTmpltToplevel .xf${xfClass}Config4 400x540 \
- "TkGS parameters:[XFMiscPathTail $xfW]" $xfLeader
-
- XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
- XFTkGSSetTkGS4 parameters $xfName 4
- XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
- background Background "Background" XFTkGSSetTkGS4
- XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass borderwidth \
- borderWidth BorderWidth "Border width" "pixels" 40 XFTkGSSetTkGS4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- bbox bbox Bbox "Bounding box" XFTkGSSetTkGS4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- command command Command "GS command" XFTkGSSetTkGS4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- file file File "File" XFTkGSSetTkGS4
- XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass orient \
- orient Orientation "Orientation" "degree" 360 XFTkGSSetTkGS4
- XFElementRelief $xfW .xf${xfClass}Config4 $xfType $xfClass \
- XFTkGSSetTkGS4
- XFElementSize $xfW .xf${xfClass}Config4 $xfType $xfClass \
- XFTkGSSetTkGS4
- XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass xdpi \
- xDpi XDpi "X Dpi" "pixels" 600 XFTkGSSetTkGS4
- XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass ydpi \
- yDpi YDpi "Y Dpi" "pixels" 600 XFTkGSSetTkGS4
- .xf${xfClass}Config4.params1.params2.size.size1.size1 conf -to 1000
- .xf${xfClass}Config4.params1.params2.size.size2.size2 conf -to 1000
-
- # save current parameter
- XFElementSave $xfW $xfClass {background bbox borderwidth command file height orient relief width xdpi ydpi}
-
- # binding
- bind .xf${xfClass}Config4.params1.params2.file.file $xfBind(configure) \
- "XFProcFSBoxFile {.xf${xfClass}Config4.params1.params2.file.file}"
-
- # packing
- pack append .xf${xfClass}Config4.params1 \
- .xf${xfClass}Config4.params1.params2 {left fill expand}
- pack append .xf${xfClass}Config4 \
- .xf${xfClass}Config4.pathname {top fill frame center} \
- .xf${xfClass}Config4.leave {bottom fill} \
- .xf${xfClass}Config4.additional {bottom fill} \
- .xf${xfClass}Config4.params1 {top fill expand}
-
- XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
- "XFTkGSSetTkGS4 $xfW 0 $xfClass"
-
- XFEditSetStatus "Calling parameter setting for TkGS...done"
- }
-
- ##########
- # Procedure: XFSaveSpecial.TkGS
- # Description: save tkGS
- # Arguments: xfW - the widget
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFSaveSpecial.TkGS {xfW} {
-
- # puts $xfOutFile ""
- # puts $xfOutFile " $xfW insert end \{[XFMiscGetText $xfW]\}"
- }
-
- ##########
- # Procedure: XFSaveWidget.TkGS
- # Description: save tkGS widget
- # Arguments: xfOutFile - the output file
- # xfW - the widget
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFSaveWidget.TkGS {xfOutFile xfW} {
- global xfConf
- global xfFile
-
- set xfType [string tolower [winfo class $xfW]]
-
- # what are we doing here ?
- puts $xfOutFile "\n # build widget $xfW"
-
- set xfTmpGSCmd [lindex [$xfW config -command] 4]
- if {"$xfTmpGSCmd" == ""} {
- set xfTmpGSCmd $xfFile(gsCmd)
- }
- puts $xfOutFile " if {\[catch \"tkgs $xfW -command $xfTmpGSCmd \"\]} {"
- puts $xfOutFile " if {\"\[info procs XFEdit\]\" != \"\"} {"
- puts $xfOutFile " XFProcError \"Unknown widget type: tkGS\""
- puts $xfOutFile " return"
- puts $xfOutFile " } {"
- puts $xfOutFile " puts stderr \"Unknown widget type: tkGS\""
- puts $xfOutFile " catch \"destroy .\""
- puts $xfOutFile " catch \"exit 0\""
- puts $xfOutFile " }"
- puts $xfOutFile " }"
-
- puts $xfOutFile " $xfW config" nonewline
- foreach xfCounter [$xfW config] {
- # only handle options with 5 items per option entry
- if {[llength $xfCounter] == 5} {
- if {"[lindex $xfCounter 0]" == "-command"} {
- continue
- }
- if {"[lindex $xfCounter 3]" != "[lindex $xfCounter 4]"} {
- if {$xfConf(encloseConfigure)} {
- puts $xfOutFile " \\\n [lindex $xfCounter 0] {[lindex $xfCounter 4]}" nonewline
- } {
- puts $xfOutFile " \\\n [lindex $xfCounter 0] \"[lindex $xfCounter 4]\"" nonewline
- }
- }
- }
- }
- puts $xfOutFile ""
- }
-
- ##########
- # Procedure: XFTkGSSetTkGS4
- # Description: set tkGS parameters
- # Arguments: xfW - the widget
- # xfType - the type of setting (1 = set always, 0 = set
- # only if permanent apply is on)
- # xfClass - the class we configure
- # xfParam1 - ignored parameter
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFTkGSSetTkGS4 {xfW xfType xfClass {xfParam1 ""}} {
- global xfConf
- global xfMisc
-
- if {$xfType == 0 && !$xfConf(applyParameters)} {
- return
- }
- XFMiscSetSymbolicName $xfW \
- [.xf${xfClass}Config4.params1.params2.symname.symname get]
-
- set tmpOptions ""
- if {"[.xf${xfClass}Config4.params1.params2.bg.bg get]" != ""} {
- append tmpOptions \
- " -background \"[.xf${xfClass}Config4.params1.params2.bg.bg get]\""
- }
- append tmpOptions \
- " -bbox \"[.xf${xfClass}Config4.params1.params2.bbox.bbox get]\""
- append tmpOptions \
- " -borderwidth [.xf${xfClass}Config4.params1.params2.borderwidth.borderwidth get]"
- append tmpOptions \
- " -command \{[.xf${xfClass}Config4.params1.params2.command.command get]\}"
- append tmpOptions \
- " -file \{[.xf${xfClass}Config4.params1.params2.file.file get]\}"
- append tmpOptions \
- " -height [.xf${xfClass}Config4.params1.params2.size.size2.size2 get]"
- append tmpOptions \
- " -orient [.xf${xfClass}Config4.params1.params2.orient.orient get]"
- append tmpOptions \
- " -relief $xfMisc(relief)"
- append tmpOptions \
- " -width [.xf${xfClass}Config4.params1.params2.size.size1.size1 get]"
- append tmpOptions \
- " -xdpi [.xf${xfClass}Config4.params1.params2.xdpi.xdpi get]"
- append tmpOptions \
- " -ydpi [.xf${xfClass}Config4.params1.params2.ydpi.ydpi get]"
- if {[catch "$xfW configure $tmpOptions" xfResult]} {
- XFProcError "$xfW\n$xfResult"
- }
- }
-
- # eof
-
-